Pensieve Header: Some analytic BCH formulae in the blobs quotient - both symmetrization and de-symmetrization.

SetDirectory["C:\\drorbn\\AcademicPensieve\\Projects\\w-Computations"];
<< "AlexanderBlobs-Program.m"

(b[r[1,3],#]& /@ Table[r[j,0], {j,3}]) /. Diag[hs_, ars___] :> hs Diag[1, ars]

B[n_, expr_] := Module[
{bra},
Transpose[Table[
bra=b[expr,r[i,0]] /. Diag[hs_, ars___] :> hs Diag[1, ars];
Coefficient[bra, r[#,0]]& /@ Range[n],
{i,n}
]]
];
EB3[expr_] := MatrixExp[B[3, expr]];
B[3, r[1,3]] // MatrixForm

B3R[i_,j_] := MatrixExp[B[3, r[i,j]]];
B3R[1,3] // MatrixForm

Symmetrization

(t1=B3R[1,3].B3R[2,3]) // MatrixForm

(t2=MatrixExp[B[3, F r[1,3]+G r[2,3]]]) // MatrixForm

Solve[
Thread[Equal[Flatten[t1], Flatten[t2]]] /. h[3] -> 1,
{F,G}
]

Solve[{a x + b==0, True}, x]

eq1=DeleteCases[Thread[Equal[Flatten[t1], Flatten[t2]]], True]

Solve[-h[1]-h[2] == -F h[1]-G h[2], G]

eq2 = DeleteCases[Simplify[eq1 /. {G->((h[1]-F h[1]+h[2])/(h[2])), h[3] -> 1}], True]

Solve[(((E^(-h[1]-h[2])) (-1+(E^(h[1]))))/(h[1]))==((F-(E^(-h[1]-h[2])) F)/(h[1]+h[2])), F]

Simplify[(((E^(-h[1]-h[2])) ((1-(E^(h[1]))-F+(E^(h[1]+h[2])) F) h[1]-(-1+(E^(h[1]))) h[2]))/(h[2] (h[1]+h[2]))) /. F->(((-1+(E^(h[1]))) (h[1]+h[2]))/((-1+(E^(h[1]+h[2]))) h[1]))]

Simplify[(((-1+(E^(h[1]))) (h[1]+h[2]))/((-1+(E^(h[1]+h[2]))) h[1])) /. {h[1] ->x, h[2]->y}]

Simplify[((h[1]-F h[1]+h[2])/(h[2])) /. {F -> (((-1+(E^x)) (x+y))/((-1+(E^(x+y))) x)), h[1] ->x, h[2]->y}]

Simplify[eq1 /. {F -> (((-1+(E^x)) (x+y))/((-1+(E^(x+y))) x)), G -> (((E^x) (-1+(E^y)) (x+y))/((-1+(E^(x+y))) y)), h[1] ->x, h[2]->y}]

FullSimplify[{(((-1+(E^x)) (x+y))/((-1+(E^(x+y))) x)), (((E^x) (-1+(E^y)) (x+y))/((-1+(E^(x+y))) y))} /. {x->-y, y->-x}]

De-Symmetrization

(s1=EB3[α r[1,3]+β r[2,3]])  // MatrixForm

(s2=EB3[ξ r[1,3]].EB3[η r[2,3]]) // MatrixForm

sol2 =Solve[
Thread[Equal[Flatten[s1], Flatten[s2]]] /. {h[1] -> x, h[2] -> y, h[3] -> 1},
{ξ,η}
] // FullSimplify

(Exp[{ξ,η}] /. sol2) // FullSimplify

({ξ,η} /. sol2 /. {α->1, β->1}) // FullSimplify